      subroutine weiprof(fngrd)

c compute weighting factors for the different forcing profiles
c case nprof>1

c neglecting staggering of the grid

c using carteian coordinates given in the topography file if available

c if nprof=1 no weighting
c if divrefstate=.false. no horizontal structure, the profiles are interpolated to the central grid point

      use alloc
      use refstate
      character*80 fngrd

      if(allocated(pweight)) deallocate(pweight)
      allocate(pweight(0:nx+1,0:ny+1,nprof))

      if(verbose.ge.2) write(*,*) 'weiprof',nprof,divrefstate

      if(iomtyp.eq.4) then
        xmountc=-xminutm
        ymountc=-yminutm
      else
        xmountc=xmount+1.5*dx
        ymountc=ymount+1.5*dy
      endif

      if(nprof.gt.1 .and. divrefstate) then
        do ix=0,nx+1
        do iy=0,ny+1
          sumdisti=0.
          do ip=1,nprof
            xis=ix*dx-xmountc
            yps=iy*dy-ymountc
            distinv(ip)=1./sqrt((xis-xprof(ip))**2+(yps-yprof(ip))**2)
            sumdisti=sumdisti+distinv(ip)
          enddo
          do ip=1,nprof
            pweight(ix,iy,ip)=distinv(ip)/sumdisti
          enddo
        enddo
        enddo
      elseif(nprof.eq.1) then
        pweight=1.
      else
        xis=(nx/2)*dx-xmountc
        yps=(ny/2)*dy-ymountc
        sumdisti=0.
        do ip=1,nprof
c         write(*,*) ip,xis,xprof(ip),yps,yprof(ip)
          distinv(ip)=1./sqrt((xis-xprof(ip))**2+(yps-yprof(ip))**2)
          sumdisti=sumdisti+distinv(ip)
        enddo
        do ip=1,nprof
          pweight(:,:,ip)=distinv(ip)/sumdisti
        enddo
      endif

      if(refout) then
        do ip=1,nprof
          call wgrids(pweight,'pw',2,nx,2,ny,ip-1,ip-1,1,0,0,0,fngrd)
        enddo
      endif
      return
      end